
module Serial where

import Char

type Grafo = [[Int]]
type Caminho = [Int]

escala = "R3Y; R3Z; R1X; W1X; W3Y; W3Z; R2Z; R1Y; W1Y; R2Y; W2Y; R2X; W2X."
--teste = percorre (montaEscala "R1X; R2Z; R1Z; R3X; R3Y; W1X; W3Y; R2Y; W2Z; W2Y.")
--geraSerie [1,2,3] [] [[1],[1,2],[2],[3],[3,2],[3,1],[3,1,2]]

{-
	Funcao principal
-}

-- Verifica se a escala e serializavel no conflito
analisa :: String -> IO ()
analisa escala
  | ciclos /= []
  	= do
  		putStrLn "Escala nao e' serializa'vel no conflito"
  		putStrLn "Ciclo(s) existente(s):"
  		escreve ciclos
  		return ()
  | otherwise
  	= do
  		putStrLn "Escala e' serializa'vel no conflito"
  		putStrLn "Possibilidade(s) existente(s):"
  		escreve seriais
  		return ()
	where
		grafo = percorre (montaEscala escala)
		lista = caminhos grafo
		ciclos = verificaCiclo lista
		seriais = verificaSerie (length grafo) lista

-- Escreve na tela cada lista
escreve :: [Caminho] -> IO()
escreve [] = putStr ""
escreve (a:x)
	= do 
		escreveAux a		
		escreve x
		return ()

escreveAux :: Caminho -> IO()
escreveAux [] = putStrLn ""
escreveAux (a:x)
	= do
		putStr ("T" ++ (show a))
		if ((length x) == 0) then putStr "" else putStr " -> "
		escreveAux x
		return ()

{-
	Funcoes para testar se os caminhos serao seriais ou terao ciclos
-}

-- Retorna uma lista das possibilidades seriais da escala
{-verificaSerie :: Int -> [Caminho] -> [Caminho]
verificaSerie _ [] = []
verificaSerie tam (a:x)
  | (length a) == tam = a : verificaSerie tam x
  | otherwise = verificaSerie tam x-}

-- Retorna uma lista das possibilidades seriais da escala 
verificaSerie :: Int -> [Caminho] -> [Caminho]
verificaSerie tam camin = tiraRepetidos seriais
	where
		seriais = geraSerie [2..tam] [[1]] camin

-- Funcao Auxiliar para gerar series
geraSerie :: [Int] -> [Caminho] -> [Caminho] -> [Caminho]
geraSerie [] parcial _ = parcial
geraSerie (a:x) parcial cam = geraSerie x parcialNovo cam
	where
		parcialNovo = geraSerieAux a parcial cam

-- Funcao Auxiliar(2) para gerar series
geraSerieAux :: Int -> [Caminho] -> [Caminho] -> [Caminho]
geraSerieAux valor [] cam = []
geraSerieAux valor (a:x) cam = parcialNovo ++ geraSerieAux valor x cam 
	where
		parcialNovo = geraSerieAux2 valor a [] cam
								
-- Funcao Auxiliar(3) para gerar series
geraSerieAux2 :: Int -> [Int] -> [Int] -> [Caminho] -> [Caminho]
geraSerieAux2 valor [] carrega cam = [carrega ++ (valor:[])]
geraSerieAux2 valor (a:x) carrega cam = 
	if (elem [valor,a] cam) then 
		[carrega ++ (valor:a:x)]
	else (if (elem [a,valor] cam) then 
			(geraSerieAux2 valor x (carrega ++ [a]) cam)
		  else (if (depende valor x cam) then
		  			(geraSerieAux2 valor x (carrega ++ [a]) cam)
				else
					[carrega ++ (valor:a:x)] ++ [carrega ++ (a:valor:x)]
					++ (geraSerieAux2 valor x (carrega ++ [a]) cam)
			   )
		 )

depende :: Int -> [Int] -> [Caminho] -> Bool
depende _ [] _ = False
depende valor (a:x) cam
	| elem [a,valor] cam = True
	| otherwise			 = depende valor x cam

-- Tira os elementos repetidos de uma lista
tiraRepetidos :: [Caminho] -> [Caminho]
tiraRepetidos [] = []
tiraRepetidos (a:x) = a : tiraRepetidos [c | c <- x, c /= a]

-- Retorna uma lista dos caminhos que sao ciclos
verificaCiclo :: [Caminho] -> [Caminho]
verificaCiclo [] = []
verificaCiclo ((a:x):y)
  | elem a x  = (a:x) : verificaCiclo y
  | otherwise = verificaCiclo y

{-
	Funcoes de manipulacao do grafo
-}

-- Gera todos os caminhos do grafo
caminhos :: Grafo -> [Caminho]
caminhos grafo = caminho 1 grafo

-- Funcao que realmente gera os caminhos
caminho :: Int -> Grafo -> [Caminho]
caminho no grafo
  | no <= (length grafo) = caminhoAux no [no] (grafo !! (no - 1)) grafo ++ caminho (no + 1) grafo
  | otherwise = []

-- Funcao auxiliar da caminho
caminhoAux :: Int -> [Int] -> [Int] -> Grafo -> [Caminho]
caminhoAux _ parcial [] _ = [parcial]
caminhoAux no parcial (a:x) grafo =
	caminhoAux no parcial x grafo ++
	if (elem a parcial) then 
		[parcial ++ [a]]
	else
		caminhoAux (a - 1) (parcial ++ [a]) (grafo !! (a - 1)) (tira (no - 1) a 0 grafo)
	
-- Retirar um no ja visitado do grafo	
tira :: Int -> Int -> Int -> Grafo -> Grafo
tira _ _ _ [] = []
tira ini fim at (a:x) 
  | ini == at = remove fim a : (tira ini fim (at + 1) x)
  | otherwise = a : (tira ini fim (at + 1) x)

-- Funcao auxiliar da tira
remove :: Int -> [Int] -> [Int]
remove _ [] = []
remove t (a:x)
  | t == a = x
  | otherwise = a : remove t x

{-
	Funcoes de manipulacao da escala para geracao do grafo
-}

-- Percorre a escala montando o grafo
percorre :: [String] -> Grafo
percorre escala = percorreAux escala (grafoInicial (maiorValor 0 escala))

-- Montagem do grafo inicial
grafoInicial :: Int -> Grafo
grafoInicial 0 = []
grafoInicial x = [] : grafoInicial (x-1)

-- Pega o maior valor da escala
maiorValor :: Int -> [String] -> Int
maiorValor v [] = v
maiorValor v (a:x)
	| digitToInt (a !! 1) > v 	= maiorValor (digitToInt (a !! 1)) x
	| otherwise 				= maiorValor v x

-- Percorre a escala montando o grafo (aux)
percorreAux :: [String] -> Grafo -> Grafo
percorreAux [] grafo = grafo
percorreAux (a:x) grafo
	| (a !! 0) == 'R' = percorreAux x (analisaRead (a !! 1) (a !! 2) x grafo)
	| (a !! 0) == 'W' = percorreAux x (analisaWrite (a !! 1) (a !! 2) x grafo)

-- Analisa conflitos com um Read
analisaRead :: Char -> Char -> [String] -> Grafo -> Grafo
analisaRead _ _ [] grafo = grafo
analisaRead no var (a:x) grafo
	| ((a !! 2) == var) && ((a !! 1) /= no) && ((a !! 0) == 'W')
		= analisaRead no var x (poeNoGrafo (digitToInt no) (digitToInt (a !! 1)) grafo)
	| otherwise = analisaRead no var x grafo

-- Analisa conflitos com um Write		
analisaWrite :: Char -> Char -> [String] -> Grafo -> Grafo
analisaWrite _ _ [] grafo = grafo
analisaWrite no var (a:x) grafo
	| ((a !! 2) == var) && ((a !! 1) /= no)
		= analisaWrite no var x (poeNoGrafo (digitToInt no) (digitToInt (a !! 1)) grafo)
	| otherwise = analisaWrite no var x grafo
		
-- Poe a relacao no grafo
poeNoGrafo :: Int -> Int -> Grafo -> Grafo
poeNoGrafo ant pro grafo
	| elem pro (grafo !! (ant - 1)) = grafo
	| otherwise = (antes ant grafo) ++ ([(grafo !! (ant - 1))++[pro]]) ++ (depois ant grafo)

-- Pega a parte do grafo antes da posicao ant
antes :: Int -> Grafo -> Grafo
antes 1 grafo = []
antes ant (a:x) = a : antes (ant - 1) x

-- Pega a parte do grafo depois da posicao ant
depois :: Int -> Grafo -> Grafo
depois 0 grafo = grafo
depois ant (a:x) = depois (ant - 1) x

-- Transforma a entrada em uma lista de operacoes
montaEscala :: String -> [String]
montaEscala [] = []
montaEscala entrada 
	= tiraEspaco (pegaOper entrada) : montaEscala (tiraOper entrada)

-- Pega a primeira operacao da entrada
pegaOper :: String -> String
pegaOper [] = []
pegaOper (a:x)
	| (a == ';') || (a == '.') = []
	| otherwise = a : pegaOper x

-- Tira a primeira operacao da entrada
tiraOper :: String -> String
tiraOper [] = []
tiraOper (a:x)
	| (a == ';') || (a == '.') = x
	| otherwise = tiraOper x

-- Tira os espacos em branco da entrada
tiraEspaco :: String -> String
tiraEspaco [] = []
tiraEspaco (a:x)
	| elem a [' ','\t','\n','\v','\f','\r','\160'] = tiraEspaco x
	| otherwise = a : tiraEspaco x